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~- ListCode.mesa; edited by Johnsson; July 20, 1978 12:17 PM 

DIRECTORY 

AUoDefs: FROM "altodefs", 
BcdDefs: FROM "bcddefs". 
CommanderDefs : FROM "commanderdef s" , 
ControlDefs: FROM "controldef s" . 
InlineDefs: FROM "in 1 inedef s" , 
lODefs: FROM "iodefs", 
ListerDefs: FROM "1 isterdef s" , 
Mopcodes: FROM "mopcodes", 
OpTableDefs: FROM "optabledef s" , 
OutputDefs: FROM "outputdef s" , 
SegmentDefs: FROM "segmentdef s" , 
StreamDefs: FROM "streamdef s" , 
StringDefs: FROM "stringdef s" , 
SymDefs: FROM "symdefs", 
SymboUableDefs: FROM "symboUabledef s" . 
TimeDefs: FROM "timedefs"; 

DEFINITIONS FROM OutputDefs; 

ListCode: PROGRAM 

IMPORTS CommanderDefs, lODefs, ListerDefs, OpTableDefs, OutputDefs, SegmentDefs, StreamDefs, 

StringDefs, Symbol TableDefs 
EXPORTS ListerDefs SHARES SymbolTabl eDef s = 
BEGIN 

BYTE: TYPE = AUoDefs . BYTE ; 

FileSegmentHandle: TYPE = SegmentDefs . FileSegmentHandle; 

FrameHandle: TYPE = ControTDef s . FrameHandle; 

NumberFormat : TYPE = lODef s .NumberFormat ; 

opcode: TYPE - BYTE; 

PageCount: TYPE = AUoDefs. PageCount; 

WordPC: TYPE = ControlDef s .WordPC; 



JumpOp: TYPE = [Mopcodes .zJ2 . .Mopcodes . zJIW] ; 

InstWord: TYPE = MACHINE DEPENDENT RECORD[oddbyte. evenbyte: BYTE]; 

offset: CARDINAL; 

codebase: POINTER; 

codepages: PageCount; 

symbols : SymbolTableDef s. Symbol Tab! eBase; 

Tinst. Tbytes, Pinst, Pbytes, Bbytes: CARDINAL; 

freqing: BOOLEAN <- FALSE; 

absolute: BOOLEAN <- FALSE; 



-- number formats 

decimal: NumberFormat - NumberFormat[base : 10 , columns:l, zerof i 1 1 : FALSE , unsigned:TRUE]; 
decimals: NumberFormat = NumberFormat[base: 10 , columns:3, zerof ill : FALSE , unsigned:TRUE]; 
octal3: NumberFormat = NumberFormat[base:8. columns:3, zerof il 1 : FALSE , unsigned : TRUE]; 
octalSz: NumberFormat = NumberFormat[base : 8, columns:3, zerof il 1 :TRUE , unsigned : TRUE] ; 
octal5: NumberFormat = NumberFormat[base:8 , columns:5, zerof il 1 : FALSE , unsigned: TRUE]; 
octal6: NumberFormat = NumberFormat[base:8 , columns:6, zerof il 1 : FALSE , unsigned : TRUE]; 
octall: NumberFormat = NumberFormat[base:8, columns:l, zerof il 1 : FALSE , unsigned : TRUE]; 
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-- generate list of opcodes 

OpcodeList: PROCEDURE [root: STRING] « 

BEGIN OPEN OpTableDefs; 

op: STRING; 

length: [0..3]; 

i : opcode ; 

digit: STRING = "0123456789"L; 

OpenOiitput[root,".1ist"L]; 

PutString["-- Mesa Opcodes 
-- Format: name octal (decimal )push, pop, length, a) igned 

"L]; 

FOR i IN opcode DO 

op ^ InstName[i]; 

IF (length <- instl ength[i]) « THEN op. length 4- O; 

PutString[op] ; 

THROUGH (op. length. .8] DO PutChar[' ] ENDLOOP; 

PutNumber[i ,octal3]; 

PutChar['(]; 

PutNumber[i .decimals]; 

PutCharC')]; 

PutChar[digit[pushstack[i]]]; 

PutChar[' ,]; Pu tChar[digit[pops tack[i]]] ; 

PutChar[' .]; PutChar[dig 1t[length]] ; 

PutChar['.]; PutChar[IF instal igned[i] THEN 'T ELSE 'F]; 

IF i MOD 4 = 3 THEN BEGIN PutChar[';]; PutCR[] END 

ELSE PutString["; "L]; 

ENDLOOP; 
CloseOutput[]; 
END; 
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-- source file procedures 

Sou rceStr earn: StreamDefs .StreamHandle; 
sourceavailable: BOOLEAN; 

printsource: PROCEDURE [index: SymDef s .Bytelndex] - 

BEGIN 
' OPEN symbols; 

j: SymDef s. Bytelndex; 

firstx. lastx: CARDINAL; 

IF -sourceavailable THEN RETURN; 
firstx<-fgTable[ index] .f index; 
lastx^LAST[CARDINAL]; 
FOR j IN [O..LENGTH[fgTable]) DO 
IF jj^index THEN 

IF fgTable[j].findex <= lastx AND 
fgTable[j].findex >= firstx THEN 
lastx ^ f gTable[j] .f index; 
ENDLOOP; 
outcheck[f irstx, lastx]; 
END; 

outcheck: PROCEDURE [xfirst: CARDINAL, xlast: CARDINAL] = 
BEGIN OPEN StreamDefs; 
nextchar: CHARACTER; 
lastcr: CARDINAL; 

FOR lastcr *- xfirst. lastcr-1 UNTIL lastcr = DO 
SetIndex[SourceStream, [0, lastcr]]; 

IF SourceStream.get[SourceStream] = lODefs.CR THEN EXIT; 
ENDLOOP; 
THROUGH (lastcr. .xfirst) DO PutChar[IODef s .SP] ENDLOOP; 
SetIndex[SourceStream,StreamIndex[0, xfirst]] ; 
WHILE xfirst ff xlast DO 

nextchar <- SourceStream.get[SourceStream 1 StreamError => GOTO eof]; 
xfirst ^ xfirst+1; 
IF nextchar = lODef s .ControlZ THEN 
WHILE nextchar ff lODefs.CR DO 

nextchar <- SourceStream.get[SourceStream 1 StreamError => GOTO eof]; 
xfirst <- xfirst+1; 
ENDLOOP; 
PutChar[nextchar]; 
REPEAT eof => NULL; 
ENDLOOP; 
IF nextchar # lODefs.CR THEN PutChar[IODef s .CR] ; 
END; 

setupsource: PROCEDURE = 
BEGIN OPEN SegmentDefs; 
sourceavailable <- TRUE; 
SourceStream <- StreamDefs .CreateByteStream[ 

NewFile[ symbol s.sourceFile.Read.Defaul tVersion 

1 FileNameError => BEGIN sourceavailable <- FALSE; CONTINUE END], Read]; 
END; 

closesource: PROCEDURE « 
BEGIN 

IF sourceavailable THEN SourceStream. destroy[SourceStream] 
END; 

PrintBodyName: PROCEDURE [bti: SymDef s .BTIndex] « 
BEGIN OPEN StringDefs, SymDef s, symbols; 
sei: ISEIndex; 
hti: HTIndex; 
ss: SubStringDescriptor ; 

IF sourceavailable THEN RETURN; 
WITH (bb+bti) SELECT FROM 

Callable «> 

IF (sei ^ id) « SENull OR (hti ^ (seb+sei ) . htptr) = HTNull THEN RETURN; 

ENDCASE «> RETURN; 
SubStringForHash[0ss , hti]; 
PutSubString[@ss]; 
PuLChar[' ;]; PutCR[]; 
END; 
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EvenUp: PROCE[>URE [n: CARDINAL] RETURNS [CARDINAL] - 
-- Round up to an even number 
BEGIN 

RETURN[n + n MOD 2]; 
END; 

getbyte: PROCEDURE [pc: CARDINAL] RETURNS [b: BYTE] « 
— pc is a byte address 
BEGIN OPEN InlineDefs; 
w: POINTER TO InstWord; 

IF absolute THEN 

BEGIN 

w<-L00PH0LE[pc/2]; 

b^IF BITAND[pc,l] ^ THEN w.evenbyte ELSE w.oddbyte; 

END 
ELSE 

BEGIN 

w<-codebase+pc/2; 

b^IF BITAND[pc.l] = THEN w.evenbyte ELSE w.oddbyte; 

END; 
END; 

getword: PROCEDURE [pc: CARDINAL] RETURNS [WORD] « 
-- pc is a word address 
BEGIN 

IF absolute THEN RETURN [MEMORY[pc]] ; 
RETURN[(codebase-+-pc)t]; 
END; 



jumpaddress: PROCEDURE [jop: opcode, arg: INTEGER] RETURNS [CARDINAL] 
BEGIN -- given a jump operator and its argument, return 

-- its target address 
OPEN Mopcodes; 
SELECT OpTab1eDefs.inst1ength[jop] FROM 

1 => 

SELECT jop FROM 

IN [zJ2..zJ9] «> arg <- jop - zJ2 + 2; 
IN [zJEQ2. .ZJEQ9] => arg ^ jop - zJEQ2 + 2; 
IN [zJNE2. .zJNEQ] => arg ^ jop - zJNE2 + 2; 
ENDCASE => ERROR; 

2 => 

IF arg > 177B THEN arg *- In! ineDef s . BITOR[arg , 177400B] ; 
ENDCASE; 
RETURN[INTEGER[offset]+arg] 
END; 



ListCode.mesa 2-Sep-78 18:18:51 Page 



outwjtab: PROCEDURE [tabstart. tablength: CARDINAL, octal: BOOLEAN] 
BEGIN 

w: INTEGER; 
pc: CARDINAL; 

Pbytes^Pbytes+tab1ength*2; 
FOR pc IN [tabstart. .tabstart+tablength) DO 
w<-getworcl[pc]; 

PutCR[]; PutTab[]; PutTab[]; 
IF octal THEN BEGIN PutTab[]; PutTab[]; END; 
PutString[" ("L]; 

PutNumber[ jumpaddress[Mopcodes .zJIW.w] ,octa15] ; 
PutChar[')]; 
ENDLOOP; 
END; 



outbjtab: PROCEDURE [tabstart, tablength: CARDINAL, octal: BOOLEAN] 
BEGIN 

b: BYTE; 

pc: CARDINAL; 

Pbytes<-Pbytes+EvenUp[ tab length] ; 

FOR pc IN [tabstart*2. .tabstart*2+tablength) DO 

b<-getbyte[InlineDefs.BITXOR[pc,l]]; -- bytes "backwards" 

IF b >= 200B THEN b <- b + 177400B; -- sign extend 

PutCR[]; PutTab[]; PutTab[]; 

IF octal THEN BEGIN PutTab[]; PutTab[]: END; 

PutString[" ("L]; 

PutNumber[Jumpaddress[Mopcodes, zJIB,b],octal5]; 

PutChar[')]; 
ENDLOOP; 
END; 
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PutPair: PROCEDURE [byte: CARDINAL] » 
BEGIN 

a: CARDINAL » byte/16; 
b: CARDINAL « byte MOD 16; 
IF a<8 AND b<8 THEN PutChar[IODef s .SP] ; 
PutChar['[]; 
PutNumber[a,octall]; 
PutChar[' ,]; 
PutNumber[b, octall]; 
PutChar[']]: 
RETURN 
END; 

printcode: PROCEDURE [startcode, endcode: CARDINAL, octal: BOOLEAN] « 
BEGIN -- list opcodes For indicated segment of code 
OPEN InlineDefs, Mopcodes; 
w: InstWord; 
inst, byte: BYTE; 
lastconstant, v: INTEGER; 
il: [0..3]; 

FOR offset IN [startcode. .endcode) DO 
inst<-getbyte[off set]; 
-- loginst[inst]; 
Pinst<-Pinst+1; 
PutTab[]; 
IF octal THEN 

BEGIN 

PutNumber[offset/2,octal5]; 

PutString[(IF offset MOD 2 = THEN ",E " ELSE ".0 ")]; 

END; 
PutNumber[off set ,octa15]; 
PutChar[' :]; 

IF octal THEN 
BEGIN 
PutTab[]; 

PutChar['[]; PutNuniber[inst .octal3z] ; PutChar[']]; 
END; 

PutTab[]; 

PutString[OpTableDef s . InstName[inst]]; 

il <- OpTableDef s . instlength[inst]; 

IF OpTableDefs.instaligned[inst] AND (offset + il) MOD 2 i^ THEN 
BEGIN 

byte <- getbyte[offset ^ offset + 1]; 
IF byte = 377B THEN PutChar['*] 
ELSE 
BEGIN 

PutString[" <"L]; 
PutNumber[ byte, octal 3]; 
PutChar['>]; 
END; 
Pbytes ♦- Pbytes + 1; 
END; 
SELECT il FROM 

0.1=>BEGIN 

Pbytes^Pbytes+1 ; 

IF inst IN [zLIO. .zLI6] THEN 

lastconstant*- inst- zL 10 
ELSE IF inst IN JumpOp THEN 

BEGIN 

PutTab[]; PutString[" ("L]; 

PutNumber[ jumpaddr ess [inst ,0] .octal 1]; 

PutChar[')]; 

END; 
END; 

2«>BEGIN 

Pbytes«-Pbytes+2: 

by te<-getbyte[{off S0t*~of f set+1)] ; 

PutTab[]; 
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SELECT inst FROM 

zRILP, zWILP, zRXLP, zWXLP. zRIGP, 
zRXLPL, zWXLPL. zRXGPL, zWXGPL, 
zRILPL, zWILPL, zRIGPL, zWIGPL «> PutPair[byte3 ; 
ENDCASE => PutNumber[byte.octa16]; 
IF inst»zLIB THEN 1 astconstant<-byte 
ELSE IF inst IN JumpOp THEN 
BEGIN 

PuhString[" ("L]; 

Pu tNumber [ j unpad dre ss [ i ns t, by te],oc tall]; 
PutChar[')]; 
END; 
END; 

3=>BEGIN 

Pbytes+-Pbytes+3; 

w.evenbyte<-getbyte[(offset^-off set+1)]; 
w.oddbyte<-getbyte[(offset«-offset+l)]; 
PutTab[]; 

SELECT inst FROM 

zRF. zWF, zWSF, zRFC. zRFL. zWFL «> 
BEGIN 

PutNumber[w.oddbyte,octal6] ; 
PutString[". "L]; 
PutPair[w.evenbyte] ; 
END; 
ENDCASE => 
BEGIN 

Pu tNumber [(v<-w. odd by te*256+w. even byte) , octal 6]; 
SELECT inst FROM 

zJIB=> outbjtab[v, lastconstant.octal]; 
zJIW='> outwjtab[v, 1 as t con Stan t, octal ] ; 
zLIW=> lastconstant<-v; 
IN JumpOp => 
BEGIN 

PutString[" ("L]; 

PutNumber[jumpad dress [inst, v] .octal 1]; 
PutChar[' )]; 
END; 
ENDCASE; 
END; 

END; 
ENDCASE; 
PutCRC]; 
ENDLOOP; 
END; 
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listonebody: PROCEDURE [bti: SymDef s .CBTIndex , octal: BOOLEAN] 
RETURNS [next: SymDef s .BTIndex] » 
BEGIN OPEN SymDef s, symbols; 
fgindex, fglast: CARDINAL; 

body: POINTER TO Callable SymDef s .BodyRecord = bb+bti; 
cspp: POINTER TO ControlDef s .CSegPref ix = codebase; 

evi: POINTER TO ControlDef s . EntryVectorl tern =» @cspp.entry[body .entrylndex] ; 
endchunk: Bytelndex; 
procstart: CARDINAL « evi . initial pc*2; 
procend: CARDINAL; 
info: External Bodylnfo; 
fsize: INTEGER <- evi . f ramesize; 

Pinst ^ Pbytes ♦- 0; 
next ^ bti + 

(WITH body SELECT FROM 

Inner => SIZE[Inner Callable BodyRecord], 
ENDCASE => SIZE[Outer Callable BodyRecord]); 
IF fsize < ControlDefs.MaxAllocSlot THEN f size*-Control Def s . FrameVec[f size] 
ELSE 

BEGIN 

Pbytes<-Pbytes+2; 

fsize<-getword [procstart /2-1]; 

END; 

PutCR[]; 

WITH i:body.info SELECT FROM 
External => info *- i ; 
ENDCASE => ERROR; 
procend *- procstart + info. bytes; 
Bbytes +- info. bytes; 
FOR fgindex IN [info. startlndex. . 

(fglas t<- info. startlndex+ info. indexLength-1)] DO 
-- find end of this piece of code 
IF fgindex = fglast THEN endchunk ^ procend 
ELSE endchunk <- f gTable[f gindex+1] . cindex; 

printsource[fgindex]; 

IF fgindex = info. startlndex THEN 

BEGIN 

PrintBodyName[bti] ; 

IF octal THEN PutTab[]; 

PutString[" Frame size: "L]; 

PutNumber [fsize, decimal]; PutCR[]; 

END; 
printcode[fgTable[f gindex] . cindex, endchunk, octal]; 
PutCR[]; 
ENDLOOP; 

IF octal THEN PutTab[]; 

PutString["Ins truct Ions: "L]; PutNumber[Pinst .decimal ] ; 
PutString[", Bytes: "L]; PutNumber[Pbytes «- EvenUp[Pbytes] .decimal ]; 
PutCR[]: PutCR[]; 

Tinst ^ Tinst + Pinst; Tbytes <- Tbytes + Pbytes; 
END; 
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ListFile: PROCEDURE [root: STRING, octal: BOOLEAN] ■ 
BEGIN OPEN StringDefs, SegmentDef s , symbols; 
i: CARDINAL; 

cseg.sseg: FileSegmentHancne; 
mintextindex: SymDef s .Bytelndex ♦- 777778; 
bti: SymDefs.BTIndex; 
bcdFile: STRING ♦- [40]; 

App0ndString[bcdFile,root]; 
FOR i IN [0.. root. length) DO 

IF root[i] = ' . THEN EXIT; 

REPEAT FINISHED ■> AppendString[bcdFi1 e , " . bcd"L] ; 

ENDLOOP; 

[cseg , sseg]<-ListerDefs .Load [bcdFile]; 

Swapln[cseg] ; 

codebase <- FileSegmentAddress[cseg] ; 

codepages <- cseg. pages; 

symbol s*-SymbolTabl eDef s .AcquireSymbolTabI e[ 

Symbol Tab leDefs .TableForSegment[sseg]] ; 
ListerDef s .SetRoutineSymbol s[ symbols] ; 
setupsource[] ; 
OpenOutput[root,".cV'L]; 
ListerDefs.WriteFileID[]; 
IF sourceavailable THEN 

BEGIN 

FOR i IN [0.,LENGTH[fgTable]) DO 

IF f gTabl e[i] .f index < mintextindex THEN 

mintextindex ^ fgTable[i] . f index; 
ENDLOOP; 

IF mintextindex # THEN outcheck[0 .mintextindex] ; 

END; 

Tbytes<-Tinst*-0; 
bti ^ LOOPHOLE[0]; 

UNTIL bti = LOOPHOLE[stHandle.bodyBlock.size, SymDefs.BTIndex] DO 
WITH (symbols. bb+bti) SELECT FROM 

Callable => bti ♦- 1 istonebody[LOOPHOLE[bti] , octal]; 
ENDCASE -> bti ^ bti + SIZE[Other SymDef s .BodyRecord] ; 
ENDLOOP; 

Symbol Tab leDefs.ReleaseSymbolTable[ symbols]; 

DeleteFileSegment[sseg]; 

Unlock[cseg]; DeleteFileSegment[cseg] ; 

closesource[] ; 

PutCR[]; IF octal THEN PutTab[]; 

PutString["Total instructions: "L]; PutNumber[Tinst .decimal ]; 

PutString[", Bytes: "L]; PutNumber[Tbytes .decimal ] ; 

PutCR[]; 

CloseOutput[]; 

END; 

LCode: PROCEDURE[name: STRING, octal: BOOLEAN] = 
BEGIN OPEN ListerDefs; 
ListFile[name .octal 

INoCode.NoFGT.NoSymbol s . IncorrectVersion => 

BEGIN IODefs.WriteString["Bad formaf'L]; CONTINUE END; 
SegmentDef s , FileNameError => 

BEGIN IODefs.WriteString["File not found"L]; CONTINUE END 

]; 

END; 

Code: PROCEDURE[name: STRING] » 
BEGIN 

LCode[name. FALSE]; 
END; 

OctalCode: PROCEDURE[name: STRING] « 
BEGIN 

LCode[name.TRUE]; 
END; 

Init: PROCEDURE - 
BEGIN 
command : CommanderDef s .CommandBlockHandle; 
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command <~ CommanderDef s .AddCommand["OpcodeList" ,LO0PH0LE[0pcodeList] , 1] ; 
command. params[0] ^ [type: string, prompt: "Filename"]; 

command <- CommanderDef s .AddCommand["OctalCode" ,L00PH0LE[0cta1Code] , 1] ; 
command .params[0] *- [type: string, prompt: "Filename"]; 

command <- CommanderDef s .AddCommand[ "Code" ,LOOPHOLE[Code] ,1] ; 
command . params[0] <- [type: string, prompt: "Filename"]; 
END; 

Init[]; 

END. of 1 istcode 



